home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.46 / quicksort / quicksortxscdynamisch.p < prev    next >
Text File  |  1995-03-27  |  1KB  |  75 lines
  1. PROGRAM quicksortXSCdynamisch;  { sortieren durch Zerlegen }
  2.  
  3. { cøding døne by Røgersøft }
  4.  
  5.  
  6. TYPE sortfeld=DYNAMIC ARRAY[*] OF REAL;
  7.   
  8. VAR anz:INTEGER;
  9.  
  10.  
  11. PROCEDURE main(n:INTEGER);
  12.  VAR feld:sortfeld[1..n];
  13.  
  14. PROCEDURE tausche(VAR element1,element2:REAL);
  15. {vertausch 2 elemente geht schneller mit exchange =;) }
  16.  
  17.  VAR puffer:REAL;
  18.  
  19.  BEGIN
  20.   puffer:=element1;
  21.   element1:=element2;
  22.   element2:=puffer; 
  23.  END;
  24.  
  25. PROCEDURE quicksort(links,rechts:INTEGER);
  26.  VAR i,j:INTEGER;
  27.        m:REAL;
  28.  BEGIN
  29.   IF links<rechts THEN
  30.   BEGIN
  31.    m:=feld[links];
  32.    i:=links;
  33.    j:=rechts;
  34.    WHILE i<=j DO
  35.    BEGIN
  36.     WHILE feld[i]<m DO i:=i+1;
  37.     WHILE feld[j]>m DO j:=j-1;
  38.     IF i<=j THEN 
  39.      BEGIN
  40.       tausche(feld[i],feld[j]);
  41.       i:=i+1;
  42.       j:=j-1;
  43.      END;
  44.    END;
  45.    quicksort(links,j);
  46.    quicksort(i,rechts);
  47.   END;
  48.  END; 
  49.  
  50.   
  51. PROCEDURE eingabe;
  52. var i:INTEGER;
  53.  BEGIN
  54.   writeln('Bitte ',n,' Elemente eingeben');
  55.   FOR i:=1 TO n DO readln(feld[i]);
  56.  END;
  57.  
  58. PROCEDURE ausgabe;
  59.  var i:INTEGER;
  60.   BEGIN
  61.    FOR i:=1 TO n DO writeln(feld[i]);
  62.   END;  
  63.  
  64. BEGIN
  65.     eingabe;
  66.  quicksort(1,n);
  67.  ausgabe;
  68. END; 
  69.  
  70. BEGIN
  71.     write('Bitte feldgröße angeben: ');
  72.  readln(anz);
  73.  main(anz);
  74. END.
  75.